COMMENT ⊗   VALID 00022 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002
C00004 00003
C00007 00004
C00010 00005
C00014 00006
C00017 00007	IFN D10,[
C00018 00008
C00019 00009
C00022 00010
C00024 00011
C00025 00012
C00030 00013
C00033 00014
C00036 00015
C00044 00016
C00046 00017
C00048 00018
C00049 00019
C00051 00020
C00056 00021	ALLDONE:	MOVEI A,LISP
C00057 00022
C00061 ENDMK
C⊗;

;;;   **************************************************************
;;;   ***** MACLISP ****** INITIALIZATION AND ALLOCATION ROUTINES **
;;;   **************************************************************
;;;   ** (C) COPYRIGHT 1978 MASSACHUSETTS INSTITUTE OF TECHNOLOGY **
;;;   ****** THIS IS A READ-ONLY FILE! (ALL WRITES RESERVED) *******
;;;   **************************************************************


SUBTTL	INITIALIZATION CODE

;;; THIS CODE IS IN BINARY PROGRAM SPACE

.CRFOFF
OBTL:	REPEAT KNOB, CONC OBT,\.RPCNT
.CRFON

INITIALIZE:
IFN D10,[
	SETZ FREEAC,
	SETUWP FREEAC,			;FREEAC HAS OLD STATE OF HISEG-PURE BIT
	.VALUE
]		;END OF IFN D10
IFN ITS,[
	MOVE TT,[4400,,400000+<<PDLORG←-PAGLOG>←11>]
	.CBLK TT,
	 .VALUE
	MOVE TT,[4400,,400000+<<SPDLORG←-PAGLOG>←11>]
	.CBLK TT,
	 .VALUE
	MOVE TT,[4400,,400000+<<FXPORG←-PAGLOG>←11>]
	.CBLK TT,
	 .VALUE
]		;END OF IFN ITS
	MOVE P,C2
	MOVE SP,SC2
	MOVE FXP,FXC2

;;; (SETPLIST '*PRINT (PLIST 'PRINT)), ETC.
IFE QIO,[
    IRP A,,[PRINT,PRIN1,PRINC,%TERPRI,%TYO]B,,[PRT,PR1,PRC,TRP,TYO]
	HRRZ F,Q!A
	HRRM F,Q!B!$
    TERMIN
]		;END OF IFE QIO

;;; FALLS THROUGH



;;; FALLS IN

INIBS:	MOVEI F,0		;BUBBLE-SORT THE LAPFIV TABLE, WHILE
	MOVEI C,LLSYMS-1	;SORTING THE BSP TABLE AS SUBSIDIARY RECORDS
INIBS1:	MOVE D,LAPFIV(C)
	CAML D,LAPFIV-1(C)
	JRST INIBS2
	MOVEI F,1		;FLAG TO NOTE THAT A BUBBLING OCCURED THIS PASS
	EXCH D,LAPFIV-1(C)
	MOVEM D,LAPFIV(C)	;INTERCHANGE KEYS
	MOVE D,INIBSP(C)
	EXCH D,INIBSP-1(C)	;INTERCHANGE RECORDS
	MOVEM D,INIBSP(C)
INIBS2:	SOJG C,INIBS1
	JUMPN F,INIBS
	MOVNI C,LLSYMS-1
	MOVE AR2A,[441100,,LAP5P]
	MOVE TT,INIBSP+LLSYMS-1(C)
	IDPB TT,AR2A
	AOJLE C,.-2


;;; INITIALIZE THE SEGMENT-LINK COUNTERS FOR ITS 

IFN ITS,[
IRP A,,[FS,FX,FL,SY,SA,S2]B,,[IFS,IFX,IFL,SYM,SAR,IS2]
	MOVEI T,L!B!SG
	MOVEM T,A!SGLK
TERMIN
BG$	MOVEI T,LBNSG
BG$	MOVEM T,BNSGLK
IRPC Q,,[AB]
IFN NXX!Q!SG,[
	MOVE T,IMSGLK
	MOVE TT,[-NXX!Q!SG,,BXX!Q!SG←-SEGLOG]
	DPB T,[SEGBYT,,GCST(TT)]
	MOVEI T,(TT)
	AOBJN TT,.-2
	MOVEM T,IMSGLK
]		;END OF IFN NXX!Q!SG
TERMIN
	MOVEI T,<<<ENDLISP+PAGSIZ-1>&PAGMSK>-BBPSSG>←-PAGLOG
	MOVEI D,BBPSSG←-PAGLOG
	ROT D,-4
	ADDI D,(D)
	ROT D,-1
	TLC D,770000
	ADD D,[450200,,PURTBL]
	MOVEI TT,3
INIT5:	TLNN D,730000
	TLZ D,770000
	IDPB TT,D
	SOJG T,INIT5
	MOVE T,[-<<<<ENDLISP+PAGSIZ-1>&PAGMSK>-BBPSSG>←-SEGLOG>,,ST+<BBPSSG←-SEGLOG>]
	MOVE TT,[$XM,,QRANDOM]
	MOVEM TT,(T)
	AOBJN T,.-1
]	;END OF IFN ITS

IFE ITS,[

;;; INITIALIZE THE SEGMENT TABLES, AND LINK COUNTERS FOR DEC-10 

    BZERSG==FIRSTLOC	;CROCK - BEWARE RELOCATION!
    BSYSSG==HILOC

IN10ST:	SETZ A,			;INIBD SETS NON-ZERO ON ERROR
	MOVEI T,FIRSTLOC
	MOVEI TT,FIRSTLOC	;DO NOT ATTEMPT TO PERFORM
	SUBI TT,STDLO		; THIS ARITHMETIC AT ASSEMBLY
	JSP F,INIBD		; TIME! WOULD USE WRONG
	   ASCIZ \LOW\		; RELOCATION QUANTITIES
	MOVEI T,HILOC
	MOVEI TT,HILOC
	SUBI TT,STDHI
	MOVEM TT,MAXNXM
	SOS MAXNXM
	JSP F,INIBD
	   ASCIZ \HIGH\
	SKIPE A
	 EXIT			;LOSE LOSE
	MOVE T,[$NXM,,QRANDOM]	;INITIALIZE SEGMENT TABLES
	MOVEM T,ST
	MOVE T,[ST,,ST+1]
	BLT T,ST+NSEGS-1
	SETZM GCST
	MOVE T,[GCST,,GCST+1]
	BLT T,GCST+NSEGS-1
	MOVEI AR1,BTBLKS		;AR1 ACTS AS BTB. [BIT-BLOCK COUNTER]
	LSH AR1,5-SEGLOG
	10ST ZER
	10ST ST
	10ST SAR,[SA,,QARRAY][GCBMRK+GCBSAR]SASGLK
	10ST VC,[LS+VC,,QLIST][GCBMRK+GCBVC]
	10ST IS2,,,S2SGLK
	10ST SYM,[SY,,QSYMBOL][GCBMRK+GCBSYM]SYSGLK
	10ST IFS,[LS+$FS,,QLIST][GCBMRK+GCBCDR+GCBCAR]FSSGLK,BITS
	10ST IFX,[FX,,QFIXNUM][GCBMRK]FXSGLK,BITS
	10ST IFL,[FL,,QFLONUM][GCBMRK]FLSGLK,BITS
BG$	10ST BN,[BN,,QBIGNUM][GCBMRK+GCBCDR]BNSGLK,BITS
	10ST BIT
	10ST FXP,[FX+$PDLNM,,QFIXNUM]
	10ST FLP,[FL+$PDLNM,,QFLONUM]
	10ST P
	10ST SP
	10ST BPS

	10ST SYS,[$XM+PUR,,QRANDOM]
	10ST SY2
	10ST PFS,[LS+$FS+PUR,,QLIST]
	10ST PFX,[FX+PUR,,QFIXNUM]
	10ST PFL,[FL+PUR,,QFLONUM]

IN10S5:	HRRM AR1,BTBAOB
	LSH AR1,SEGLOG-5
	CAIN AR1,BFBTBS
	 JRST IN10S8
	OUTSTR [ASCIZ \LOST WHILE INITIALIZING BIT BLOCKS
\]
	EXIT 1,
IN10S8:

EXPUNGE BZERSG BSYSSG

]		;END OF IFE ITS



ININTR:	MOVE A,[-KNOB+1-10,,OBTFS+1]	;SET UP OBLIST-LINKING CONSING AREAS
	HRRZM A,-1(A)
	AOBJN A,.-1
	MOVEI F,OBTFS
	MOVEM F,FFS
	MOVE F,[-KNOB,,OBTL]
	HRRZ A,(F)
	PUSHJ P,INTERN
	AOBJN F,.-2

INIRND:	JSP F,IRAND		;INITIALIZE RANDOM NUMBER GENERATOR

;INITIALIZE INTERRUPT MASKS IN MEMORY
10$	MOVE T,[STDMSK]
10%	MOVE T,[DBGMSK]
	MOVEM T,IMASK
IT$ Q$	MOVE T,[DBGMS2]
IT$ Q$	MOVEM T,IMASK2

IFN ITS,[
  	MOVE A,[SETO AR1,]
	MOVEM A,PURIFY
	MOVE A,BINIT9				;CLOBBER INIT, SINCE ONLY NEED DO ONCE
	MOVEM A,INITIALIZE
	.BREAK 12,[..SSTA,,[LISPGO]]		;SET START ADDRESS
  	.CORE <ENDLISP+PAGSIZ-1>←-PAGLOG	;FLUSH PDL PAGES
	 .VALUE
BINIT9:	.VALUE [ASCIZ \:}INITIALIZED}
\]
]	;END OF IFN ITS
IFN D10,[
	MACROLOOP N2DIF,ZZD,*
	MOVE C,[LVRNO]
	SETZ A,
INIT2A:	SETZ B,
	LSHC B,6
	JUMPE B,INIT2B
	IMULI A,10.
	ADDI A,-'0(B)
	JRST INIT2A
INIT2B:	LSH A,30		;VERSION NUMBER STORED IN LOC 137 AS
	MOVEM A,137		;0XXX00,,0
	MOVEI A,LISPGO
	HRRM A,.JBSA"
	MOVEM A,INIT
;SA$	MOVEI FREEAC,1	;SAIL SETUWP DOES NOT RETURN OLD VALUE IN AC AS DEC10
SA%	SETUWP FREEAC,	;RESTORE WRITE PROTECT STATUS
SA%	.VALUE
IFE SAIL,[
	OUTSTR [ASCIZ \:$INITIALIZED$
\]
	EXIT 1,
]		;END OF IFE SAIL
IFN SAIL,[
	SETZ T,
	GETNAM T,
	MOVEM T, SGANAM
;	 JRST INIT7B
	PUSHJ P,SAVHGH		;SAVE HIGH SEGMENT AS SYS:MACLSP.SHR
	 JRST INIT7A
	OUTSTR [ASCIZ \:$INITIALIZED; HIGH SEGMENT SAVED$
\]
	SETZ T,			;RECALL THAT A CRUFTY CODE 15 MAKES PTLOAD HAPPY
	MOVE TT,[440700,,[ASCIZ \SAVE SYS:MACLSP
\]]
	PTLOAD T		;STICK SAVE COMMAND IN LINE EDITOR
	MOVEI T,INIT99
	HRRM T,RETHGH
	JRST KILHGH		;FLUSH HIGH SEGMENT

INIT7A:	OUTSTR [ASCIZ \:$FAILED TO SAVE HIGH SEGMENT$
\]
INIT7B:	OUTSTR [ASCIZ \:$INITIALIZED$
\]
	SETZ T,			;RECALL THAT A CRUFTY CODE 15 MAKES PTLOAD HAPPY
	MOVE TT,[440700,,[ASCIZ \SSAVE SYS:MACLSP
\]]
	PTLOAD T		;STICK SAVE COMMAND IN LINE EDITOR
	EXIT 1,
]		;END OF IFN SAIL
]		;END OF IFN D10
INIT99:	JRST LISPGO

;;; NOTE THAT THE SECOND $ IN THE MESSAGE HERE IS A REAL DOLLAR SIGN,
;;; WHILE THE OTHER TWO ARE ALTMODES; THUS DDT WON'T GET SCREWED!

IFN ITS,[
NOTINIT: .VALUE [ASCIZ \:}LISP NOT INITIALIZED (USE INIT$G)}
\]
]		;END OF IFN ITS

INIBSP:	REPEAT LLSYMS, .RPCNT

IFN D10,[

;;; ROUTINE TO CHECK SEGMENT BOUNDARIES, AND IF LOSING,
;;; TELL LOSER HOW TO WIN WITH LINK-10.

INIBD:	TRNN TT,SEGKSM
	 JRST 1(F)		;WIN
	SETO A,
	OUTSTR (F)
	OUTSTR [ASCIZ \ SEGMENT ON BAD BOUNDARY. TELL LINK "/SET:.\]
	OUTSTR (F)
	OUTSTR [ASCIZ \.:\]
	ANDI TT,SEGKSM
	ADDI T,SEGSIZ
	SUBI T,(TT)
	HRLZ TT,T
	MOVEI D,6
INIBD1:	SETZ T,
	LSHC T,3
	ADDI T,"0
	OUTCHR T
	SOJG D,INIBD1
	OUTSTR [ASCIZ \"
\]
	JRST 1(F)

]		;END OF IFN D10

IFN ITS,[
IFE SEGLOG-11,[		;VARIOUS PARAMETERS BUILT INTO UCODE
IFLE HNKLOG-5,[

;;; KL-10 INIT ROUTINE

KLINIT:	MOVE T,[-NSEGS,,GCST]
KLINI1:	MOVE TT,(T)
IFN HNKLOG,	TLNN TT,GCBFOO+GCBHNK
.ELSE		TLNN TT,GCBFOO
	 JRST KLINI2
	SETO D,
	TLNE TT,GCBSYM
	 MOVEI D,0
	TLNE TT,GCBVC
	 MOVEI D,1
	TLNE TT,GCBSAR
	 MOVEI D,2
IFN HNKLOG,[
	HRRZ R,ST(T)
	TLNE TT,GCBHNK
    2DIF [MOVEI D,(R)]3,QHUNK1
]		;END OF IFN HNKLOG
	SKIPGE D
	 .VALUE
IFN HNKLOG,	TLZ TT,GCBFOO+GCBHNK
.ELSE		TLZ TT,GCBFOO
	TLO TT,200000
	DPB D,[330300,,TT]
	MOVEM TT,(T)
KLINI2:	AOBJN T,KLINI1
	MOVE T,[JRST KLGCM1]
	MOVEM T,GCMRK0
	MOVE T,[JRST KLGCSW]
	MOVEM T,GCSWP
	.VALUE [ASCIZ \:}INITIALIZED FOR KL-10}
\]

]		;END OF IFLE HNKLOG-5
]		;END OF IFE SEGLOG-11
]		;END OF IFN ITS
IFN D10,[
LOPDL==200
LOFXPDL==100
LOSPDL==40
LOFLPDL==10
ALBPS==7000
SA$ ALBPS==ALBPS+4000
]		;END OF IFN D10

SUBTTL	HAIRY ALLHACK MACRO

DEFINE AMASC A,B
	ASCIZ \
A!B	\
TERMIN

DEFINE ALLHACK XLABEL,TP,NAME,STDALC,MINALC,EXTRA,WHERE,NWHERE
	SKIPE ALLF
	JRST XLABEL
	PUSHJ P,ALLTYO
	AMASC [TP! !NAME = ]\STDALC
	MOVE AR1,[ASCII \NAME\]
	PUSHJ P,ALLNUM
	SKIPGE A
XLABEL:	MOVEI A,STDALC
	CAIGE A,MINALC
	MOVEI A,MINALC
IFSN EXTRA,,	ADDI A,EXTRA
	HRRM A,WHERE
IFSN NWHERE,,[
	MOVN B,A
	HRRM B,NWHERE
]
	PUSHJ P,ALLECO
TERMIN

SUBTTL	ALLOC I/O ROUTINES

10% ALLJCL:	BLOCK 80.	;BUFFER UP JOB COMMAND LINE IF THERE WAS ONE.
10% ALJCLP:	-1	;ALLOW ONLY ONE TRY FOR JCL (JOB COMMAND LINE)
ALLF:	0	;NON-ZERO FOR STANDARD ALLOCATION
AINFIL:	0	;NON-NIL MEANS LOAD .LISP. (INIT) FILE AFTER ALLOCING
ATYF:	0	;TTYOFF FOR ALLOC
LICACR:	0	;LAST INPUTED CHAR TO ALLOC WAS A CR   -1 ==> YES
ALERR:	STRT [SIXBIT \GC CALLED FROM ALLOC - LOSE, LISP IS DEAD!\]
	.VALUE


;;;	PUSHJ P,ALLTYO		;PRINT ASCIZ STRING FOR ALLOC
;;;	   ASCIZ \TEXT...\	;NOTE: ASCIZ IS NOT IN [ ... ] !

ALLTYO:	HRLI A,440700
	HLLM A,(P)
ATYOI:	ILDB A,(P)
	JUMPE A,POPJ1
	SKIPN ATYF
	PUSHJ P,ALLTYC
	JRST ATYOI

ALLECO:	SKIPL AFILRD
	SKIPE ATYF
	POPJ P,
	PUSH P,A
	MOVE TT,A
	HRROI R,TYO
	PUSHJ P,PRINL4
	POP P,A
	POPJ P,
IFN SAIL,[
SAILP4:	CAIN C,32		;A TILDE?
	JRST SAIP1
	CAIN C,176		;A ~
	JRST SAIP2
	CAIE C,175		;AN ALTMODE
	JRST SAIP3
	MOVEI C,33
	JRST SAIP3
SAIP1:	MOVEI C,176
	JRST SAIP3
SAIP2:	MOVEI C,175
SAIP3:	TRZE C,600	;CTRL/META/BOTH?
	TRZ C,140
	CAIN C,121
	MOVEI C,21
	CAIN C,161
	MOVEI C,21
	CAIN C,127
	MOVEI C,27
	CAIN C,167
	MOVEI C,27
	POPJ P,
]	;END OF IFN SAIL

ALLTYI:
IFN ITS,[
Q%	.IOT TYIC,C
Q$	.IOT 0,C		;CHANNEL NUMBER FILLED IN
]	;END OF IFN ITS
IFN D10,[
	INCHRW C
SA$	PUSHJ P,SAILP4
	AOSG LICACR
	JRST ATI1
ATI2:	CAIN C,↑M
	SETOM LICACR
]	;END OF IFN D10
10X WARN [TTY INPUT]
	CAIN C,↑G
	JRST ALLOC1
	POPJ P,

IFN D10,[
ATI1:	CAIN C,↑J		;FLUSH A SYSTEM-SUPPLIED LINE-FEED
	INCHRW C		;FOLLOWING A CR
SA$	PUSHJ P,SAILP4
	JRST ATI2
]	;END OF IFN D10

ALLTYC:
IFN ITS,[
	CAIE A,↑J
 ALOIOT:
 Q%	.IOT TYOC,A
 Q$	.IOT 0,A		;QIO WILL CLOBBER CHANNEL HERE
]	;END OF IFN ITS
10$	OUTCHR A
10X WARN [TTY OUTPUT]
	POPJ P,

ALLRUB:	PUSHJ P,ALLTYO
	ASCIZ \XX
\
ALLNUM:	SKIPGE C,AFILRD	;GETS A NUMBER FOR SOME STORAGE AREA SIZE
	JRST ALNM1
ALNM2:	JUMPN C,ALNM27
	SETO A,
	POPJ P,
ALNM27:	HLRZ A,(C)	;SEARCH THE READ IN LIST TO SEE
	HRRZ C,(C)	;WHETHER LOSER HAS TRIED TO SPECIFY
	JUMPE C,ALLNER	;ALLOCATION FOR THIS QUANTITY
  	SKOTT A,SY
  	JRST ALSYER
  	HLRZ A,(A)
  	HRRZ A,1(A)
	HLRZ AR2A,(A)
	HLRZ A,(C)
	CAMN AR1,(AR2A)
	JRST ALNM3
	HRRZ C,(C)
	JRST ALNM2

ALNM3:
  	SKOTT A,FX
	JRST ALNMER
ALNMOK:	MOVE A,(A)
	POPJ P,

ALSYER:	MOVEI D,[SIXBIT \NON-SYMBOL ALLOCATION AREA!\]
	JRST ALCLZ1

ALNMER:	MOVEI D,[SIXBIT \NON-FIXNUM ALLOCATION QUANTITY!\]
	JRST ALCLZ1

ALLNER:	MOVEI D,[SIXBIT \ODD LENGTH ALLOCATION COMMENT!\]
	JRST ALCLZ1

ALNM1:	MOVSI B,400000
	MOVSI A,400000	;GET VALUE FROM TTY
ALNM1A:	PUSHJ P,ALLTYI
	CAIE C,12
	CAIN C,15
	POPJ P,
	CAIE C,33	;ALT MODE SAYS "DONE ALLOCING"
	JRST .+3
	SETOM ALLF
	POPJ P,
	CAIN C,".
	MOVE A,B
	MOVE D,RCT0(C)
	TLNE D,170000
	POPJ P,
	CAIL C,"0
	CAILE C,"9
	JRST ALLRUB
	TLZ A,400000
	TLZ B,400000
	IMULI A,10
	ADDI A,-"0(C)
	IMULI B,10.
	ADDI B,-"0(C)
	JRST ALNM1A

IFN D10,[
DECDIG:	SKIPE ATYF
	POPJ P,
	JUMPN T,DDIG1
	OUTCHR [ASCII \0\]
DDIG1:	JUMPE T,CPOPJ
	IDIVI T,10
	PUSH P,TT
	PUSHJ P,DECDIG
	POP P,TT
	ADDI TT,"0
	OUTCHR TT
	POPJ P,
]		;END OF IFN D10

SUBTTL	ALLOC (INIT) FILE ROUTINES

IFE QIO,[

ALOFIL:
IFN ITS,[	MOVEI C,(SIXBIT \DSK\)	;STANDARD FILE NAMES
	MOVE A,[SIXBIT \.LISP.\]	; FOR INIT FILE
	MOVE B,[SIXBIT \(INIT)\]
	TDZA F,F		;F=0 => INIT REQUESTED VIA ↑Q OR ↑W
ALOFL1:	MOVNI F,1		;F<0 => INIT REQUESTED VIA JCL
ALOFL2:	MOVEM A,UTIN+1
	HRLI C,2
	MOVEM C,UTIN
	MOVEM B,UTIN+2
	.OPEN UTIC,UTIN		;SO TRY TO OPEN INIT FILE
	JRST ALFLER		;FILE NAMES ARE STILL IN A AND B
	SKIPLE F		;F>0 => WERE TRYING (INIT) DIRECTORY
	.SUSET [.SSNAM,,A]	; - WE WANT TO RESTORE OUR SNAME
]		;END OF IFN ITS
IFN D10,[
	MOVE A,[SIXBIT \LISP\]
	MOVSI B,(SIXBIT \INI\)
	MOVSI C,(SIXBIT \DSK\)
ALOFL1:	MOVEI C+2,UTIHED
	MOVE C+1,C
	MOVEI C,0
	OPEN UTIC,C		;OPEN THE CHANNEL
	JRST ALFLER
	SETZB C,AR1		;USE NO PPN
SA$	DSKPPN=047000,,400071
SA$	DSKPPN AR1,
	LOOKUP UTIC,A
	JRST ALFLER		;FILE NAMES ARE STILL IN A AND B
	MOVEI T,UTIB-3
	EXCH T,.JBFF"
	INBUF UTIC,NIOBFS
	EXCH T,.JBFF"
]		;END OF IFN D10
	LOCKI			;UREAD2 WILL UNLOCKI
	MOVEM A,URFN1
IT$	MOVEM B,URFN2
10$	HLLZM B,URFN2
20$	WARN [WHAT THE HECK? IN ALOFIL]
	SETOM ALGCF		;TELLS UREAD NOT TO TRY TO CONS
	PUSHJ P,UREAD2		;DOES AN UNLOCKI
	SETZM ALGCF
	MOVEI A,TRUTH
	MOVEM A,TAPRED
	SETOM AFILRD
	POPJ P,
]		;END OF IFE QIO

IFN QIO,[
ALOFIL:
IFN ITS,[
	MOVSI C,(SIXBIT \DSK\)
	MOVE A,[SIXBIT \.LISP.\]
	MOVE B,[SIXBIT \(INIT)\]
	.SUSET [.RSNAM,,F]
ALOFL1:	.CALL ALOFL6		;DOES INIT FILE EXIST?
	JRST ALOFL2
	MOVEM C,INIIF2+F.DEV	;YES, SAVE FILE NAMES
	MOVEM F,INIIF2+F.SNM
	MOVEM A,INIIF2+F.FN1
	MOVEM B,INIIF2+F.FN2
	JRST ALOFL4
ALOFL2:	CAMN B,[SIXBIT \(INIT)\]	;IF SECOND FILE NAME IS (INIT),
	.CALL ALOFL7			; TRY THE (INIT) DIRECTORY
	JRST ALFLER			;OTHERWISE LOSE
	MOVEM C,INIIF2+F.DEV		;SAVE FILE NAMES
	MOVEM B,INIIF2+F.SNM
	MOVEM F,INIIF2+F.FN1
	MOVEM A,INIIF2+F.FN2
ALOFL4:	.CLOSE TMPC,
];END IFN ITS
IFN D10,[
	HRLZI C+1,(SIXBIT/DSK/)
	MOVE A,[SIXBIT/LISP/]
	HRLZI B,(SIXBIT/INI/)
ALOFL1:	SETZB C,C+2
	OPEN TMPC,C
	 JRST ALFLER		;NO DISK?
	MOVEM C+1,INIIF2+F.DEV
	SETZB C,C+1
	LOOKUP TMPC,A
	 JRST ALFLER
	SETZM INIIF2+F.PPN
	MOVEM A,INIIF2+F.FN1
	HLLZM B,INIIF2+F.FN2
	CLOSE TMPC,
];END IFN D10
	PUSH P,[ALOFL5]
	PUSH P,[INIIFA]
	MOVNI T,1
	JRST $OPEN		;OPEN INIT FILE ARRAY
ALOFL5:	MOVEM A,VINFILE
	MOVEI A,TRUTH
	MOVEM A,TAPRED
	SETOM AFILRD
	POPJ P,

IFN ITS,[
ALOFL6:	SETZ
	SIXBIT \OPEN\		;OPEN FILE
	  5000,,2		;MODE (ASCII BLOCK INPUT)
	  1000,,TMPC		;CHANNEL #
	      ,,C		;DEVICE
	      ,,A		;FILE NAME 1
	      ,,B		;FILE NAME 2
	400000,,F		;SNAME

ALOFL7:	SETZ
	SIXBIT \OPEN\		;OPEN FILE
	  5000,,2		;MODE (ASCII BLOCK INPUT)
	  1000,,TMPC		;CHANNEL #
	      ,,C		;DEVICE
	      ,,F		;FILE NAME 1
	      ,,A		;FILE NAME 2
	400000,,B		;SNAME
];END IFN ITS
]		;END OF IFN QIO

ALLFIL:	PUSHJ P,ALOFIL		;OPEN INIT FILE
ALLFL1:
Q%	SETOM RRDF
Q$	SETZM BFPRDP
	PUSHJ P,READ		;READ IN ALLOCATIONS "COMMENT"
	SETZM ALGCF
	HLRZ B,(A)
	CAIE B,Q$COMMENT
	JRST ALCLUZ
ALLFL2:	HRRZ A,(A)
	MOVEM A,AFILRD		;SAVE IT (ACTUALLY, ITS CDR)
	JRST ALLOCC

ALCLUZ:	MOVEI D,[SIXBIT \ALLOC COMMENT MISSING IN INIT FILE!\]
ALCLZ1:
Q%	MOVE A,URFN1
Q%	MOVE B,URFN2
IFN QIO,[
	HRRZ A,VINFILE
	SETZM VINFILE
	PUSH FXP,D
	PUSHJ P,$CLOSE
	POP FXP,D
	MOVE A,INIIF2+F.FN1
	MOVE B,INIIF2+F.FN2
IT$	MOVE F,INIIF2+F.SNM
10$	MOVE F,INIIF2+F.PPN
]		;END OF IFN QIO
	JRST ALCERR

IFN ITS,[
ALLTTS:	SETZ		;TTYSET FOR ALLOC - NO INTERRUPT CHARS!
	SIXBIT \TTYSET\		;SET TTY VARIABLES
Q%	  1000,,TYIC		;CHANNEL #
Q$	      ,,TTYIF2+F.CHAN	;CHANNEL #
	      ,,[STTYA1]	;TTYST1
Q%	      ,,[STTYA2]	;TTYST2
Q$	400000,,[STTYA2]
Q%	400000,,STTYSS		;TTYSTS
]		;END OF IFN ITS

ALHELP:	PUSHJ P,ALLTYO
	ASCIZ \
N = DON'T ALLOCATE (I.E. USE DEFAULTS)
Y = ALLOC FROM TTY
↑Q = READ INIT FILE AND ALLOC FROM IT
↑S = ALLOC FROM TTY, THEN READ INIT FILE
↑W = SAME AS ↑Q, BUT NO ECHO ON TTY
ALTMODE, TYPED AT ANY TIME, TERMINATES ALLOCATION PHASE, 
   TAKING REMAINING PARAMETERS AS DEFAULTS.
↑G RESTARTS ALLOC.
LINES PROMPTED BY A "#" CANNOT BE RE-ALLOCATED AFTER RUNNING.
   OTHERS CAN BE RE-ALLOCATED AT ANY TIME
   WITH THE LISP FUNCTION "ALLOC".
TERMINATE EACH NUMERIC ENTRY WITH CR OR SPACE.
A CR OR SPACE TYPED WITHOUT A PRECEDING NUMBER
   ASSUMES THE DEFAULT FOR THAT ENTRY.
RUBOUT RESTARTS THE CURRENT ENTRY.
NUMBERS ARE TYPED IN BASE EIGHT, UNLESS SUFFIXED BY ".",
   IN WHICH CASE BASE TEN IS USED.
ALL ENTRIES ARE IN UNITS OF PDP-10 WORDS.
\
	JRST ALLOC1

ALFLER:
IFE D10\QIO,[
	JUMPG F,ALFLE3		;LOSE IF WE ALREADY TRIED (INIT);
	CAME B,[SIXBIT \(INIT)\]
	JRST ALFLE3		;LOSE IF SECOND NAME NOT (INIT)
	MOVE B,A		;ELSE PERMUTE  FOO;BAR (INIT)  TO BE
	.SUSET [.RSNAM,,A]	;  (INIT);FOO BAR  INSTEAD
	.SUSET [.SSNAM,,[SIXBIT \(INIT)\]]
	MOVEI F,1		;WE CAN ONLY TRY THIS HACK ONCE
	JRST ALOFL2

ALFLE3:	JUMPL F,ALFLE4		;IF WE WERE LOOKING AT THE (INIT)
	.SUSET [.SSNAM,,A]	; DIRECTORY, MUST RESTORE THINGS
	MOVE A,B
	MOVE B,[SIXBIT \(INIT)\]
ALFLE4:
]		;END OF IFE D10\QIO
	MOVEI D,[SIXBIT \   INIT FILE NOT FOUND!\]
ALCERR:	SETZM TAPRED
	SETZM TTYOFF
	SETZM TAPWRT
	STRT [SIXBIT \    !\]
IFN ITS,[
Q%	.SUSET [.RSNAM,,AR1]
Q$	MOVE AR1,F
	MOVEI T,";
	PUSHJ P,ALFL6
]		;END OF IFN ITS
	MOVE AR1,A
10%	MOVEI T,40
10$	MOVEI T,".
	PUSHJ P,ALFL6
	MOVE AR1,B
	MOVEI T,40
	PUSHJ P,ALFL6
	STRT (D)
SA$	CLRBFI			;CLEAR INPUT BUFFER FOR SAIL
	MOVNI T,0		;SETUP FOR NO ARG LSUBR CALL
	JRST QUIT		; (VANILLA-FLAVORED QUIT)

ALFL6:	SETZ AR2A,
	MOVE TT,[440600,,AR1]
ALFL6A:	ILDB R,TT
	JUMPE R,ALFL6B
	ADDI R,40
10% Q%	.IOT TYOC,R
10% Q$	ALFL6C:	.IOT 0,R	;CHANNEL # FILLED IN
10$	OUTCHR R
10X WARN [TTY OUTPUT]
	JRST ALFL6A
ALFL6B:
10% Q%	.IOT TYOC,T
10% Q$	.IOT 0,T		;CHANNEL # FILLED IN
10$	OUTCHR T
10X WARN [TTY OUTPUT]
	POPJ P,

SUBTTL	MAIN ALLOC INTERACTION CODE

ALLOC:
IFN D10,[
	SETZM LICACR		;LAST INPUT CHAR TO ALLOC WAS? CR - NO!
IFE SAIL,[
	MOVEM 0,SGANAM		;SAVE MAGIC STUFF FOR GETHGH
	MOVEM 11,SGADEV
	MOVEM 7,SGAPPN
	MOVE A,[%CNMNT]		;GET MONITOR TYPE WORD
	GETTAB A,
	 SETZB A,SGANAM
	LDB A,[.BP CN%MNT,A]	;1 = TOPS-10, 2 = ITS, 3 = TENEX, ...
	CAIE A,1		;REAL TOPS-10 SYSTEM, RATHER THAN SIMULATOR?
	 SETZB A,SGANAM		; ON VARIOUS SIMULATIONS, DONT KILL HISEG
]		;END OF IFE SAIL
Q$	MOVEI A,ENDLISP+PAGSIZ-1;MUST DO CRUFTY CALCULATION BY HAND AS INVOLVES
Q$	ANDI A,PAGMSK		;BOOLEAN OPS AND RELOCATABLE SYMBOLS (BARF!!)
Q$	SUBI A,EINIFA
Q$	MOVEM A,IGCFX1
]		;END OF IFN D10
	MOVE A,[RCT0,,RCT]
	BLT A,RCT+LRCT-1
IFN ITS,[
	MOVE TT,[4400,,400000+<<PDLORG←-PAGLOG>←11>]
	.CBLK TT,
	.VALUE
	MOVE TT,[4400,,400000+<<SPDLORG←-PAGLOG>←11>]
	.CBLK TT,
	.VALUE
	MOVE TT,[4400,,400000+<<FXPORG←-PAGLOG>←11>]
	.CBLK TT,
	.VALUE
	MOVE TT,[4400,,400000+<<FLPORG←-PAGLOG>←11>]
	.CBLK TT,
	.VALUE
]		;END OF IFN ITS
	MOVE P,C2
	MOVE SP,SC2
	MOVE FXP,FXC2
	MOVE FLP,FLC2
	MOVE A,[-LFSALC+1,,FSALC+1]	;SET UP ALLOC CONSING AREAS
	HRRZM A,-1(A)
	AOBJN A,.-1
	MOVE A,[-LFWSALC+1+NIFWAL,,FWSALC+1+NIFWAL]
	HRRZM A,-1(A)
	AOBJN A,.-1
	MOVE A,[-LSYALC+1,,SYALC+1]
	HRRZM A,-1(A)
	AOBJN A,.-1
	MOVE A,[-NIS2SG*SEGSIZ/2+1,,SY2ALC+2]
	HRRZM A,-2(A)
	ADDI A,1
	AOBJN A,.-2
	MOVE A,[-INFVCS+1,,BFVCS+1]
	HRRZM A,-1(A)
	AOBJN A,.-1
	MOVEI A,FSALC		;SET UP PHONY FREELISTS
	MOVEM A,FFS
	MOVEI A,FWSALC+NIFWAL
	MOVEM A,FFX
  	MOVEI A,SYALC
  	MOVEM A,FFY
	SETOM ALGCF		;ERROR OUT ON GC (UNTIL FURTHER NOTICE)
	SETZB NIL,ATYF
	SETOM AFILRD
IFE QIO\<ITS-1>,[
	MOVSI TT,(ASCII \@\)
	MOVEM TT,UFN1
	MOVEM TT,UFN2
	MOVE TT,[STTYW1]
	MOVEM TT,STTYS1
	MOVE TT,[STTYW2]
	MOVEM TT,STTYS2
	PUSHJ P,TTYOPN
]		;END OF IFE QIO\<ITS-1>
IFN QIO,[
IT$	.SUSET [.RSNAM,,T]
10$	GETPPN T,
10$	 JFCL
IRP FIL,,[TTYIF2,TTYOF2]
IT$	MOVEM T,FIL+F.SNM
10$	MOVEM T,FIL+F.PPN
TERMIN
	PUSH FXP,[SIXBIT \DSK\]
	PUSH FXP,T
REPEAT 2, PUSH FXP,[SIXBIT \@\]
	PUSHJ P,6BTNML
	MOVEM A,VDEFAULTF
	PUSHJ P,OPNTTY		;OPEN TTY INPUT AND OUTPUT
	 .VALUE			;MUST HAVE TTY TO DO ALLOC
IFN ITS,[
	MOVE T,TTYOF2+F.CHAN	;INITIALIZE CHANNEL NUMBER FOR
	DPB T,[270400,,ALOIOT]	; ALLOC'S OUTPUT .IOT TO TTY
	DPB T,[270400,,ALFL6B]
	DPB T,[270400,,ALFL6C]
	MOVE T,TTYIF2+F.CHAN	;NOW DO THE SAME FOR
	DPB T,[270400,,ALLTYI]	; THE INPUT .IOT
]	;END IFN ITS
]		;END OF IFN QIO
IFN ITS,[
	AOSE ALJCLP
	JRST ALJ3
	.SUSET [.ROPTION,,TT]
	TLNE TT,20000	;NOT DDT ABOVE LISP
	TLZN TT,40000	;IF THERE IS JOB COMMAND LINE, TURN IT OFF AFTER READING
	JRST ALJ3	;NO JOB COMMAND LINE
	.BREAK 12,[..RJCL,,ALLJCL]
	SETZB A,C
	SETZB D,F
	MOVE B,[SIXBIT \(INIT)\]
	MOVE AR1,[440700,,ALLJCL]
ALJ1:	MOVE AR2A,[440600,,T]
	SETZ T,
ALJ1A:	ILDB TT,AR1
	JUMPE TT,ALJ2
	CAIGE TT,"!
	JRST ALJ1B
	CAIE TT,":
	JRST ALJ1A1
Q%	HLRZ C,T
Q$	MOVE C,T
	AOJA D,ALJ1

ALJ1A1:	CAIE TT,";
	JRST ALJ1A2
	MOVE F,T
	AOJA D,ALJ1

ALJ1A2:	CAIL TT,"a	;LOWER-CASE
	CAILE TT,"z
	ADDI TT,40
	ANDI TT,77
	TLNE AR2A,770000
	IDPB TT,AR2A
	JRST ALJ1A

ALJ1B:	JUMPE T,ALJ1B2
	JUMPE A,ALJ1B1
	MOVEM T,B
	JRST ALJ1B2
ALJ1B1:	MOVEM T,A
ALJ1B2:	CAIN TT,33		;ALTMODE MEANS INIT FILE CAN GET JCL
	JRST ALJ2Q
	CAIE TT,↑M
	JRST ALJ1
ALJ2:	.SUSET [.ROPTION,,TT]
	TLZ TT,OPTCMD		;TURN OFF JCL
	.SUSET [.SOPTION,,TT]
ALJ2Q:	SKIPN C
Q%	MOVEI C,(SIXBIT \DSK\)
Q$	MOVSI C,(SIXBIT \DSK\)
	JUMPN A,ALJ2A
	JUMPE D,ALJ3
	MOVE A,[SIXBIT \.LISP.\]
ALJ2A:	SKIPE F
	.SUSET [.SSNAM,,F]
Q$	SKIPN F
Q$	.SUSET [.RSNAM,,F]
	SETOM ATYF
	PUSHJ P,ALOFL1
	JRST ALLFL1

ALJ3:	.CALL ALLTTS
	.VALUE
]		;END OF IFN ITS

IFN D10,[
	JSP F,JCLSET
	SKIPN SJCLBUF
	 JRST ALJ3
	SETZ D,			;D TELLS WHETHER OR NOT A . WAS SEEN
	SETZB A,C
	MOVSI B,(SIXBIT \INI\)
	MOVE AR1,[440700,,SJCLBUF+1]
ALJ1:	MOVE AR2A,[440600,,T]
	SETZ T,
ALJ1A:	ILDB TT,AR1
	JUMPE TT,ALJ2
	CAIGE TT,"!
	JRST ALJ1B
	CAIE TT,":
	JRST ALJ1A1
	MOVE C,T
	JRST ALJ1

ALJ1A1:	CAIE TT,".
	JRST ALJ1A2
	MOVE A,T
	SETZ B,
	AOJA D,ALJ1

ALJ1A2:	CAIL TT,"a		;LOWER CASE
	CAILE TT,"z
	ADDI TT,40
	ANDI TT,77
	TLNE AR2A,770000
	IDPB TT,AR2A
	JRST ALJ1A

ALJ1B:	JUMPE T,ALJ1B2
	SKIPN D
	SKIPA A,T
	HLLZ B,T
ALJ1B2:	CAIN TT,33	;ALT-MODE SAYS DONT FLUSH JCL
	JRST ALJ2Q
	CAIN TT,↑M
	JRST ALJ1
ALJ2:	SETZM SJCLBUF
ALJ2Q:	SKIPN C+1,C
	MOVSI C+1,(SIXBIT \DSK\)
	SETOM ATYF
	PUSHJ P,ALOFL1
	JRST ALLFL1

ALJ3:
]		;END OF IFN D10
	PUSHJ P,ALLTYO
	ASCIZ \
LISP \
	MOVE B,[LVRNO]
ALLOCB:	SETZ A,
	LSHC A,6
	JUMPE A,ALLOCA
	ADDI A,40
	PUSHJ P,ALLTYC
	JRST ALLOCB

ALLOCA:
IFN D10*<1-QIO>,[
	PUSHJ P,SIXJBN
	MOVE TT,D10NAM ;MOVE IN ###LSP FOR FILENAME
	MOVEM TT,UFN1
	MOVSI TT,(SIXBIT /TMP/)
	MOVEM TT,UFN2
]		;END OF IFN D10*<1-QIO>
	PUSHJ P,ALLTYO
IFN ITS,[
Q%	ASCIZ \ WITH LOSING OLD I/O\
Q$	ASCIZ \ WITH WINNING NEW I/O\
]
IFE ITS,[
Q% 	ASCIZ \ WITH OLD I/O\
Q$	ASCIZ \ WITH NEW I/O\
]
ALLOC1:	PUSHJ P,ALLTYO
	ASCIZ \
ALLOC? \
	PUSHJ P,ALLTYI
	SETZM ALLF
	CAIN C,↑W
	SETOM ATYF
	CAIE C,↑W
	CAIN C,↑Q
	JRST ALLFIL
	CAIE C,33	;ALTMODE
	CAIN C,40	;SPACE
	SETOM ALLF
	CAIE C,↑S
	JRST .+3
	SETOM AINFIL
	JRST ALLOCC
	CAIE C,"n	;LOWER CASE
	CAIN C,"N
	SETOM ALLF
	SKIPE ALLF
  	JRST ALLOCC
	CAIE C,"Y
	CAIN C,"y	;LOWER CASE
	JRST ALLOCC
	CAIN C,"?
	JRST ALHELP
	CAIE C,"H
	CAIN C,"h	;LOWER CASE
	JRST ALHELP
SA$	BEEP=047000,,400111
SA$	SETOM A
SA$	BEEP A,
SA%	MOVEI A,↑G	;RANDOM ILLEGAL CHARACTER TO ALLOC
SA%	PUSHJ P,ALLTYC
Q% 10%	.RESET TYIC,	;RESET ANY TYPE-AHEAD
Q% 10$	CLRBFI
Q$ 10%	.CALL CKI2I
Q$ 10%	.VALUE
	JRST ALLOC1


IFN ITS,[  ALCORX==<BBPSSG-SEGSIZ*<NIFSSG+NIFXSG+NIFLSG+NXXZSG>>/PAGSIZ
	   ALCORE==ALCORX+<MAXFFS+MAXFFX+MAXFFL+MAXFFB+MAXFFY+MAXFFA+PAGSIZ-1>/PAGSIZ
]
.ELSE [	   ALCORX==<BBPSSG-FIRSTLOC+STDLO-SEGSIZ*<NIFSSG+NIFXSG+NIFLSG+NXXZSG>>/PAGSIZ
	   ALCORE==ALCORX+4
]

ALLOCC:
10$	ALLHACK ASBPS,#,BPS,ALBPS,ENDLISP-BBPSSG,,BPSH
	ALLHACK ASRPDL,#,REGPDL,ALPDL,200,100,OC2
	ALLHACK ASSPDL,#,SPECPDL,ALSPDL,200,100,OSC2
	ALLHACK ASFXP,#,FXPDL,ALFXP,200,LSWS+12,OFXC2
	ALLHACK ASFLP,#,FLPDL,ALFLP,10,10,OFLC2
10$	ALLHACK ASDDT,#,DDTSYMS,100,20,,SYMLO
	ALLHACK ASLIST,,LIST,MAXFFS,200,,XFFS
	ALLHACK ASSYM,,SYMBOL,MAXFFY,200,,XFFY
	ALLHACK ASFIX,,FIXNUM,MAXFFX,200,,XFFX
	ALLHACK ASFLO,,FLONUM,MAXFFL,200,,XFFL
IFN BIGNUM,	ALLHACK ASBIG,,BIGNUM,MAXFFB,100,,XFFB
	ALLHACK ASARY,,ARRAY,MAXFFA,100,,XFFA
	PUSHJ P,ALLTYO
	ASCIZ \
\


SUBTTL	RUNTIME STORAGE ALLOCATION

	MOVEI TT,ALCORX*PAGSIZ
IRP Q,,[S,X,L,B,Y,A]Z,,[FS,FX,FL,BN,SY,SA]N,,[NIFSSG+2,NIFXSG+2
NIFLSG+1,NBNSG,NSYMSG+1,NSARSG]FLG,,[1,1,1,BIGNUM,1,1]
IFN FLG,[
	MOVEI T,<N>*SEGSIZ
	CAML T,XFF!Q
	MOVEM T,XFF!Q
	MOVE T,XFF!Q
	CAMGE T,G!Z!SIZ
	MOVEM T,G!Z!SIZ
	ADD TT,T
	LSH T,-4	;HACK
	CAIGE T,SEGSIZ
	MOVEI T,SEGSIZ
	CAILE T,4000
	MOVEI T,4000
	CAML T,G!Z!SIZ
	SUBM T,G!Z!SIZ
]		;END OF IFN FLG
TERMIN
	MOVEI D,ALCORE
	SUB D,TT
	JUMPLE D,ALLCZX
IRP Q,,[S,X,L,Y]%%%,,[70.,15.,3.,12.]
	MOVEI T,(D)
	IMULI T,%%%
	IDIVI T,100.
	ADDM T,XFF!Q
TERMIN
ALLCZX==.

;FALLS THROUGH


;FALLS IN

IFE D10,[

ALLCPD:	SETZ F,
	MOVEI R,MEMORY-NSCRSG*SEGSIZ
IRP Q,,[SC2,C2,FLC2,FXC2]Y,,[1,0,0,0]W,,[SPDL,PDL,FLP,FXP]
	MOVEI T,(R)
	SUBI T,MIN!W
	EXCH T,O!Q
	CAIGE T,MIN!W
	MOVEI T,MIN!W
	MOVEM T,X!W
	ADDI T,PAGSIZ-1+MIN!W
	ANDI T,PAGMSK
	MOVEI TT,(T)
	LSH TT,-PAGLOG
	SUBI F,(TT)
	SUBI R,(T)
	MOVEI D,PAGSIZ-20
	CAML D,X!W
	MOVE D,X!W
	MOVNS D
	HRLS D
	HRRI D,(R)
IFN <Y>,	ADD D,R70+Y
	MOVEM D,Q
	MOVEI D,(R)
	ADD D,X!W
	ANDI D,777760	;KEEP AWAY FROM PAGE BOUNDARIES!
	TRNN D,PAGKSM
	SUBI D,20
	MOVEM D,X!W
	MOVEM D,Z!W
TERMIN
	HRLM F,PDLFL1
	IMULI F,SGS%PG
	HRLM F,PDLFL2
	MOVEI F,(R)
	LSH F,-PAGLOG
	HRRM F,PDLFL1
	MOVEI F,(R)
	LSH F,-SEGLOG
	HRRM F,PDLFL2
	SUBI R,1
	MOVEM R,HINXM
	HRRZ A,SC2
	MOVEM A,ZSC2
	HRRZ A,C2
	ADDI A,1
	MOVEM A,NPDLH
	HRRZ A,FXC2
	ADDI A,1
	MOVEM A,NPDLL
	JRST ALLDONE

]		;END OF IFE D10


;FALLS IN

IFN D10,[

ALLCPD:	MOVEI A,BFXPSG
	MOVEM A,NPDLL
	MOVEI B,LOFXPDL		;SET UP FXP
	ADD B,OFXC2
	ADDI B,SEGSIZ-1
	ANDI B,SEGMSK
	MOVNI C,-LOFXPDL(B)
	MOVSI C,(C)
	HRRI C,-1(A)
	MOVEM C,FXC2
	ADDI C,-LOFXPDL(B)
	HRLI C,-LOFXPDL
	MOVEM C,OFXC2
	MOVE C,[FX+$PDLNM,,QFIXNUM]
	JSP T,ALSGHK
	MOVEI B,LOFLPDL		;SET UP FLP
	ADD B,OFLC2
	ADDI B,SEGSIZ-1
	ANDI B,SEGMSK
	MOVNI C,-LOFLPDL(B)
	MOVSI C,(C)
	HRRI C,-1(A)
	MOVEM C,FLC2
	ADDI C,-LOFLPDL(B)
	HRLI C,-LOFLPDL
	MOVEM C,OFLC2
	MOVE C,[FL+$PDLNM,,QFLONUM]
	JSP T,ALSGHK
	MOVEM A,NPDLH
	MOVEI B,LOPDL+LOSPDL+1		;SET UP P AND SP
	ADD B,OC2
	ADD B,OSC2
	MOVEI AR1,SEGSIZ-1(B)
	ANDI AR1,SEGMSK
	MOVEI AR2A,(AR1)
	MOVEI F,(A)
	SUBI AR1,(B)
	LSH AR1,-1			;SPLIT SEGMENT REMAINDER
	MOVE B,OC2
	ADDI B,LOPDL(AR1)
	MOVNI C,-LOPDL(B)
	MOVSI C,(C)
	HRRI C,-1(A)
	MOVEM C,C2
	ADDI C,-LOPDL(B)
	HRLI C,-LOPDL
	MOVEM C,OC2
	ADDI A,(B)
	MOVE B,OSC2
	ADDI B,LOSPDL+1(AR1)
	MOVNI C,-LOSPDL-1(B)
	MOVSI C,(C)
	HRRI C,(A)	.SEE UBD	;SP NEEDS FUNNY SLOT
	MOVEM C,SC2
	HRRZM C,ZSC2
	ADDI C,-LOSPDL-1(B)
	HRLI C,-LOSPDL
	MOVEM C,OSC2
	MOVEI A,(F)
	MOVEI B,(AR2A)
	MOVE C,[$XM,,QRANDOM]
	JSP T,ALSGHK
	MOVEM A,BPSL
	MOVEM A,VBP1
	MOVE C,A
	ADDB C,BPSH		;FIRST ESTIMATE OF BPSH
	HRRE B,.JBSYM
	JUMPLE B,ALCPD1		;ONLY HACK SYMBOLS IF IN LOW SEGMENT
	SUB B,SYMLO
	CAIG C,(B)
	MOVE C,B
	MOVEM C,BPSH		;SECOND ESTIMATE OF BPSH
	ADD C,SYMLO
	HLRE B,.JBSYM"
	HRRO D,.JBSYM
	SUB D,B
	SUBI D,1			;TO BE A PDL PTR IN THE SYMMOV
	SUB C,B
ALCPD1:	IORI C,SEGKSM			;HIGHEST ADDR FOR AUGMENTED SYMTAB
	MOVEI B,1(C)
	CAMG C,.JBFF
	 JRST .+3
	CORE C,
	 JRST ALQX2
	HRRM B,.JBFF"
	MOVEI F,-1(B)
	SUB B,BPSL		;TOTAL NUMBER WDS OCCUPIED BY RANDOM BPS AND SYMTAB
	SUBI F,(D)		;TOTAL DISTANCE THAT SYMTAB MOVES
	HRRE R,.JBSYM
	JUMPLE R,ALQX1		;ONLY HACK SYMBOLS IF THERE OR IN LOW SEGMENT
	HLRE R,.JBSYM
	JUMPE F,ALQX1
	MOVE TT,[SYMMOV,,SYMMV1]
	BLT TT,LPROGS
	HRRI SYMMV1,(F)
	JRST SYMMV1
SYMMV6:	ADDI SYMMV1,1(D)
	HRRM SYMMV1,.JBSYM"
	SUB SYMMV1,SYMLO
	SUBI SYMMV1,1
	HRRZM SYMMV1,BPSH			;IF THERE WAS A SYMTAB, NOW WE KNOW WHERE BPSH IS
IFE SAIL,[
	MOVE F,[112,,11]
	GETTAB F,
	 SETZ F,
	LDB F,[061400,,A]
	CAIN F,3
	 HRRM SYMMV1,@770001		;TENEX SIMULATOR FOR TOPS-10
]		;END OF IFE SAIL
ALQX1:	MOVE C,SYMLO
	ASH C,-1
	MOVEM SYMLO			;CONVERT FROM # OF WORDS TO  # OF ENTRIES
	HRRZ C,BPSH
Q$	SUB C,IGCFX1			;IF NEWIO, MUST ALLOW FOR INITIAL ARRAY
	MOVEM C,VBPE1			;INITIAL SETTING OF BPEND
	MOVE C,[$XM,,QRANDOM]
	JSP T,ALSGHK
	MOVEI C,-1(A)
	MOVEM C,HIXM
	MOVEI B,HILOC
	ANDI B,SEGMSK
	SUBI B,(A)
	MOVE C,[$NXM,,QRANDOM]
	JSP T,ALSGHK
	JRST ALLDONE

ALSGHK:	MOVEI TT,(A)
	MOVNI D,(B)
	LSH TT,-SEGLOG
	ASH D,-SEGLOG
	HRLI TT,(D)
	MOVEM C,ST(TT)
	AOBJN TT,.-1
	ADDI A,(B)
	JRST (T)

ALQX2:	PUSHJ P,ALLTYO
	ASCIZ \
CAN'T GET ENOUGH CORE!\
	JRST ALLOC1
]		;END OF IFN D10

ALLDONE:	MOVEI A,LISP
	HRRM A,LISPSW
10$	MOVEI A,GOINIT
10$	HRRM A,.JBSA"
	SETZM ALGCF		;GC IS OKAY NOW
	JRST LISP


IFN D10,[

SYMMOV:			;MOVE MOBY JOB SYMBOL TABLE UPWARDS
OFFSET C-.
SYMMV1:	POP D,.(D)	;C
	AOJL R,SYMMV1	;AR1
	JRST SYMMV6	;AR2A
LPROGS==.-1
OFFSET 0
.HKILL SYMMV1

]		;END OF IFN D10



IFN QIO,[

;;; INITIAL ARRAYS IN SYSTEM GO HERE.
	.SEE GCMKL
	.SEE IGCMKL
	.SEE VBPE1


SUBTTL	INITIAL INIT FILE ARRAY FOR .LISP. (INIT) FILE

	-F.GC,,INIIF2		;GC AOBJN POINTER
INIIF1:	JSP TT,1DIMS
		INIIFA		;POINTER TO SAR
		0		;CAN'T ACCESS
INIIF2:
OFFSET -.
	FI.EOF::	NIL		;EOF FUNCTION
	FI.BBC::	0,,NIL		;BUFFERED BACK CHARS
	FI.BBF::	NIL		;BUFFERED BACK FORMS
			BLOCK 5
	F.MODE::	0		;MODE (BLOCK ASCII DSK INPUT)
	F.CHAN::	-1		;CHANNEL # (INITIALLY ILLEGAL)
	20$ F.JFN::	-1		;JOB-FILE NUMBER
	20%		0
	F.FLEN::	0		;FILE LENGTH
	F.FPOS::	-1		;FILEPOS
			BLOCK 3
IFN ITS+D10,[
	F.DEV::		SIXBIT \DSK\	;DEVICE
IT$	F.SNM::		0		;SNAME (FILLED IN)
10$	F.PPN::		0		;PPN (FILLED IN)
IT$	F.FN1::		SIXBIT \.LISP.\	;FILE NAME 1
10$	F.FN1::		SIXBIT \LISP\
IT$	F.FN2::		SIXBIT \(INIT)\	;FILE NAME 2
10$	F.FN2::		SIXBIT \INI\
	F.RDEV::	BLOCK 4		;.RCHST'D NAMES
]		;END OF IFN ITS+D10
IFN D20,[
	F.DEV::		ASCIZ \DSK\	;DEVICE
		BLOCK L.6DEV-<.-F.DEV>
	F.DIR::				;DIRECTORY (FILLED IN)
		BLOCK L.6DIR-<.-F.DIR>
	F.FNM::		ASCIZ \INIT\	;FILE NAME
		BLOCK L.6FNM-<.-F.FNM>
	F.EXT::		ASCIZ \MACLISP\	;EXTENSION
		BLOCK L.6EXT-<.-F.EXT>
	F.VRS::				;VERSION
		BLOCK L.6VRS
]		;END OF IFN D20
LOC INIIF2+LOPOFA
		BLOCK 5
	AT.CHS::	0		;CHARPOS
	AT.LNN::	0		;LINENUM
	AT.PGN::	0		;PAGENUM
		BLOCK 10
LONBFA::
	FB.BYT::	0		;BYTE SIZE
	FB.BFL::	0		;BUFFER LENGTH
	FB.BVC::	0		;COUNT OF VALID CHARACTERS
IFN ITS+D20,[
	FB.IBP::	0		;INITIAL BYTE POINTER
	FB.BP::		0		;BYTE POINTER
	FB.CNT::	0		;CHARACTER COUNT
		BLOCK 2
]		;END OF IFN ITS+D20
IFN D10,[
	FB.HED::	0		;BUFFER HEADER
	FB.NBF::	0		;NUMBER OF BUFFERS
	FB.BWS::	0		;SIZE OF BUFFER IN WORDS
SA%		0
SA$	FB.ROF::	0		;RECORD OFFSET
		BLOCK 1
]		;END OF IFN D10
	FB.BUF::
IFN ITS+D20,	BLOCK RBFSIZ
IFN D10,	BLOCK NIOBFS*<LIOBUF+3>

OFFSET 0
LINIFA==:.-INIIF1+1		;TOTAL NUMBER OF WORDS
EINIFA::			;END OF ARRAY

]		;END OF IFN QIO